home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
gametp20.zip
/
RSAMPLE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-11-07
|
34KB
|
1,370 lines
Program RSquid;
{$X+ }
{$R- }
{$M 38467,0,655360 }
{ RSQUID ver 1.5 Copyright 1992 by Scott D. Ramsay }
{ Requires Turbo Pascal 6.0 and units:
VGAKERN.TPU
MISCFUNC.TPU
KEYBOARD.TPU
IMAGING.TPU
GMORPH.TPU
BEFFECTS.TPU
OOPOBJS.TPU
DSOUND.TPU
JOYSTICK.TPU
LIMEMS.TPU
FLICS.TPU }
{ }
{ I really don't feel like commenting this program. Hopefully }
{ most of the functions and procedures are self explanatory. }
{ I know it's sloppy coding, but I've tried to use all the }
{ functions and I'm not out to win an award. }
{ The Game pretty much covers almost all aspects of game program }
{ }
{ If you have any questions about the code, or help explain, send }
{ me e-mail at: }
{ ramsays@access.digex.com }
{ }
{ Changes from 1.0: }
{ Uses GameTP20 units. }
{ ■ Allows use with joysticks }
{ ■ Uses Sound Blaster compatible cards. In this example the }
{ sounds are stored in EMS because of the sprites. If you }
{ have more than 600k of free space, you can probably store }
{ it in the heap space. Change the line in the SETUP }
{ procedure: }
{ sounds[d] := new(PEMSsound,init(path+sndname[d])); }
{ to: }
{ sounds[d] := new(Psound,init(path+sndname[d])); }
{ ■ Plays the actual FLS (FLI with sound) introduction }
{ ■ Shots bounce off girls. (No harm to them!) ;> }
{ ■ Detail level 'D' shows fast mode. No paralax scroll. No }
{ transparent maps. ( Can make it even faster ) }
{ note: You can use a different GEO file for not transparent.}
{ i.e. look at the walk platforms. (The look bad where the }
{ black is showing. Create a similar GEO that is a }
{ complete filled box as a walk platform }
{ ■ Uses GMP files from GEOMAKER. }
{ see procedure loadGMP }
{ ■ The TCycle modifications allows for background to scroll }
{ up and down. }
Uses Crt,VgaKern,MiscFunc,KeyBoard,Imaging,Gmorph,Beffects,OopObjs,Flics,Dsound,Joystick;
type
soundtype = (shoot,explode,fried,girl_hit);
const
sndname : array[soundtype] of string =
('ghit.voc','expl.voc','fried.voc','ric1.voc');
path = '';
gmx = 100;
gmy = 50;
smx = gmx shl 4-1;
smy = gmy shl 4-1;
joydo : byte = 0;
speed : boolean = true;
speedw : boolean = false;
firew : boolean = false;
lvlbc : array[0..5] of byte =
(186,80,233,239,222,208);
type
data1 = record
safe,flip,
vdx,vdy,guys,
vx,vy,drx : integer;
lvls : array[0..2] of integer;
score : longint;
turn,blown : boolean;
end;
pshot= ^tshot;
tshot = object(tobjs)
ndx,ndy : integer;
constructor init;
procedure drawitemobject;virtual;
procedure calcitemobject;virtual;
function checkhit(hx,hy:integer;var item:pobjs):boolean;virtual;
end;
pgirl = ^tgirl;
tgirl = object(tshot)
goup,godown : boolean;
constructor init;
procedure calcitemobject; virtual;
function checkhit(hx,hy:integer;var item:pobjs):boolean;virtual;
procedure drawitemobject;virtual;
procedure checkplayertouch; virtual;
end;
pclod = ^tclod;
tclod = object(tshot)
constructor init;
procedure calcitemobject; virtual;
procedure drawitemobject;virtual;
end;
pnake = ^tnake;
tnake = object(tshot)
trn : boolean;
constructor init;
procedure drawitemobject;virtual;
function checkhit(hx,hy:integer;var item:pobjs):boolean;virtual;
procedure calcitemobject;virtual;
procedure checkplayertouch;virtual;
end;
psimm = ^tsimm;
tsimm = object(tnake)
constructor init;
procedure drawitemobject;virtual;
procedure checkplayertouch;virtual;
end;
PMyCycle = ^TMyCycle;
TMyCycle = object(Tcycle)
procedure cycle_move; virtual;
end;
PMyMorph = ^TMyMorph;
TMyMorph = object(TMorph)
function geomap(x,y:integer):integer;virtual;
procedure placegeo(x,y,geonum:integer;var geos);virtual;
procedure pre_map; virtual;
procedure post_map; virtual;
end;
var
drols,girls : array[0..48] of pointer;
nakes : array[0..116] of pointer;
simmers : array[0..15] of pointer;
rsmisc : array[0..17] of pointer;
ip : array[1..9] of boolean;
sounds : array[soundtype] of PEMSsound;
gwmp,gpic,
nummo : array[0..30] of pointer;
kill : pkill;
nkbeg,nkend : plist;
player : data1;
map : array[0..gmy-1,0..gmx-1] of byte;
girls_out : integer;
blv : shortint;
paused,warp : boolean;
canchk : word;
jcx,jcy,
stx,geo_count,
ovx,ovy,gx,gy : integer;
oldexit : pointer;
dac : RGBlist;
MyCycle : PMyCycle;
MyMorph : PMyMorph;
procedure pause_ptr;external; { A VSP file using BINOBJ.EXE }
{$l paused.obj }
procedure cleanup;far;
var
d : soundtype;
begin
for d := shoot to girl_hit do
dispose(sounds[d],done);
closemode;
exitproc := oldexit;
end;
procedure drawstatus(h:integer);
var
xp : integer;
begin
setpageactive(1);
xp := h shl 1+h+73;
with player do
begin
if lvls[h]<22
then
begin
if lvls[h]<1
then bar(xp,156,xp+1,178,lvlbc[h shl 1])
else bar(xp,156,xp+1,177-lvls[h],lvlbc[h shl 1]);
end;
if lvls[h]>0
then bar(xp,178-lvls[h],xp+1,178,lvlbc[h shl 1+1]);
end;
setpageactive(2);
end;
procedure page1stuff;
var
p : plist;
d : integer;
begin
setpageactive(2);
bar(14,155,63,178,0);
p := nkbeg;
while p<>nil do
with p^.item^ do
begin
if boolean(mapcolor)
then pset(14+nx shr 4 shr 1,155+ny shr 4 shr 1,mapcolor);
p := p^.next;
end;
with player do
pset(14+vx shr 4 shr 1,155+vy shr 4 shr 1,$c0);
fastwmatte(14,155,63,178,pages[2]^,pages[1]^);
for d := 0 to 2 do
drawstatus(d);
end;
procedure update;
var
p : pointer;
begin
if paused
then
begin
p := @pause_ptr; setpageactive(2);
fastput(98,64,p^);
end;
fastwmatte(13,20,172+128,179-32,pages[2]^,pages[1]^);
page1stuff;
end;
procedure ifix(var a:integer;min,max:integer);
begin
if a<min
then a := min
else
if a>max
then a := max;
end;
procedure drawperson;
var
nx,ny : integer;
begin
with player do
begin
nx := 148; ny := 85-16;
if safe>0
then
begin
dec(nx,ord(safe<30)*random(4));
dec(ny,ord(safe<75)*random(2)-ord(safe<30)*random(4));
end;
if blown
then fbitdraw(nx,ny+4,rsmisc[2+flip]^)
else
case drx of
0 : if safe>0
then fbitdraw(nx,ny+8,rsmisc[1]^)
else fbitdraw(nx,ny,drols[flip]^);
1 : if turn
then fbitdraw(nx,ny,drols[flip]^)
else fbitdraw(nx,ny,drols[32+flip]^);
-1 : if turn
then fbitdraw(nx,ny,drols[flip]^)
else fbitdraw(nx,ny,drols[16+flip]^);
end;
end;
end;
procedure drawitems(over:boolean);
var
p : plist;
begin
p := nkbeg;
while p<>nil do
begin
if (p^.item^.overshow=over)
then p^.item^.drawitemobject;
p := p^.next;
end;
end;
procedure strobe;
const
{ This is a hack procedure. I didn't feel like doing the calcuation for CLC }
clc : array[0..30] of byte =
(15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15);
var
d : integer;
begin
setpageactive(1);
stx := (stx+5) mod 286;
line(14,14,299,14,0);
for d := 0 to 30 do
pset((stx+d) mod 286+14,14,176+clc[d]);
end;
procedure titlepage;
begin
fsetcolors(zdc);
loadpcx(path+'rsqud.pcx');
fadein(200,zdc,rgb256);
leavelast := true;
fli_play(path+'rsqud.fls',8,1,false);
end;
procedure searchjoystick;
begin
if not joythere
then exit;
if joy1there
then joydo := 1
else joydo := 2;
writeln;
write('Use Joystick? (Y/N)');
repeat until ch in ['Y','N'];
if ch='N'
then
begin
joydo := 0;
exit;
end;
writeln;
writeln('Move joystick ',joydo,' to bottom-right and press button 1');
repeat
setstick(joydo);
until button1[joydo];
jcx := stickx[joydo];
jcy := sticky[joydo];
writeln('Move joystick ',joydo,' to top-left position and press button 2');
repeat
setstick(joydo);
until button2[joydo];
jcx := (jcx-stickx[joydo])div 3;
jcy := (jcy-sticky[joydo])div 3;
if jcx=0 { Avoid Divison by zero error }
then jcx := 1;
if jcy=0
then jcy := 1;
end;
procedure loadGMP(f:string);
var
mapsize,
spx,spy : word; { Geo sprite width,height }
wpx,wpy : word; { Map Size }
fil : file;
begin
assign(fil,f);
reset(fil,1);
blockread(fil,spx,sizeof(word)); blockread(fil,spy,sizeof(word));
blockread(fil,wpx,sizeof(word)); blockread(fil,wpy,sizeof(word));
mapsize := wpx*wpy;
blockread(fil,map,mapsize);
geo_count := 0;
while not eof(fil) do { load VSP sprites at end of file }
begin
getmem(gpic[geo_count],buffsize(spx,spy));
blockread(fil,gpic[geo_count]^,buffsize(spx,spy));
inc(geo_count);
end;
close(fil);
end;
procedure setup;
var
d : soundtype;
begin
clrscr;
writeln('Scott D. Ramsay presents:');
writeln;
writeln('R-SQUID v1.5 (unfinished, always will be)');
writeln;
writeln('This is a quick-and-dirty example of various effects PC''s can do.');
writeln(' This "puppy", is going to be slow on lower-end PC''s because I''m');
writeln('pushing the computer to the limits. Transparent tile maps and wavering');
writeln('backgrounds will slow things down. You''ll need at least 600k of');
writeln('free ram. VGA display, and EMS memory for sound (For sound you also');
writeln('need a Sound Blaster compatible card). A 16mhz machine or faster is');
writeln('recommended. (16mhz might be too slow for your liking)');
writeln(' Use the "D" key during play to remove details for faster play.');
writeln;
write('Press a key.');
clearbuffer;
repeat until ch<>#1;
clearbuffer;
clrscr;
writeln;
writeln('Controls :');
writeln(' Joystick - (If available) Move Dude');
writeln(' button 1 - Fire shots');
writeln(' Arrows - Move Dude');
writeln(' up = jump, up elevators');
writeln(' down = down elevators');
writeln(' right = take a guess');
writeln(' left = -(right)');
writeln(' SPACE - Fire shots');
writeln(' D - Toggle detail level, (fast/slow)');
writeln(' P - Pause screen');
writeln(' A - Add a nake');
writeln(' S - Add a simmer');
writeln(' -/+ - Adjust brightness');
writeln(' ESC - Quit');
writeln;
write('Press a key.');
clearbuffer;
repeat until ch<>#1;
clearbuffer;
if not ScardSetup(0,0)
then writeln('Sound card not found');
searchjoystick;
openmode(3); randomize;
titlepage;
oldexit := exitproc; exitproc := @cleanup;
loadvsp(path+'drols.vsp',drols);
loadvsp(path+'girls.vsp',girls);
loadvsp(path+'nakes.vsp',nakes);
loadvsp(path+'simmers.vsp',simmers);
loadvsp(path+'rsmisc.vsp',rsmisc);
loadGMP(path+'rsquid.gmp');
loadvsp(path+'dr2.vsp',nummo);
loadcolors(path+'rsquid.pal',dac,255);
for d := shoot to girl_hit do
sounds[d] := new(PEMSsound,init(path+sndname[d]));
fadeout(50,zdc,rgb256);
setpageactive(3);
loadpcx(path+'fire.pcx');
setpageactive(1);
loadpcx(path+'dash.pcx');
fadein(60,zdc,dac);
end;
procedure addnake;
var
p : plist;
begin
new(p);
p^.item := new(pnake,init);
p^.item^.powner := p;
addp(nkbeg,nkend,p);
end;
procedure setparms;
var
d : integer;
p : plist;
begin
MyCycle := new(PMyCycle,init(34,22));
MyCycle^.cyc_x := 13; MyCycle^.cyc_y := 20;
MyCycle^.from_x:= 0; MyCycle^.from_y:= 20;
MyCycle^.cyc_height := 128; MyCycle^.cyc_width := 320;
MyMorph := new(PMyMorph,init(gmx,gmy,19,9,13,20));
warp := true; stx := 0; girls_out := 5;
kill := nil; paused := false; blv := 0;
nkbeg := nil; nkend := nil;
with player do
begin
lvls[0] := 16; lvls[1] := 10; lvls[2] := 22;
vx := 44; vy := 55; flip := 7; score := 0;
ovx := vx; ovy := vy; vdx := 0; vdy := 0; guys := 3;
drx := 0; turn := false; safe := 100; blown := false
end;
for d := 1 to 20 do
begin
new(p);
p^.item := new(pclod,init);
addp(nkbeg,nkend,p);
end;
for d := 1 to girls_out do
begin
new(p);
p^.item := new(pgirl,init);
addp(nkbeg,nkend,p);
end;
for d := 1 to 10 do
addnake;
end;
procedure printscore;
var
s : string;
d : byte;
begin
s := lz(player.score,8);
setpageactive(1);
for d := 0 to length(s)-1 do
fastput(d*21+130,158,nummo[ord(s[d+1])-ord('0')]^);
setpageactive(2);
end;
function elevat(vx,vy:integer):boolean;
var
cx,cy : integer;
d : byte;
begin
d := 0;
cx := (vx) shr 4; cy := (vy+15) shr 4;
if map[cy,cx] in [9,10]
then d := 1;
cx := (vx+9) shr 4; cy := (vy+15) shr 4;
if map[cy,cx] in [9,10]
then inc(d);
elevat := boolean(d);
end;
function canfall(vx,vy:integer): boolean;
var
cx,cy : integer;
d : byte;
begin
d := 0;
cx := (vx) shr 4; cy := (vy+16) shr 4;
canchk := map[cy,cx];
if not (map[cy,cx] in [1,3,6,8])
then d := 1;
cx := (vx+9) shr 4; cy := (vy+16) shr 4;
if not (map[cy,cx] in [1,3,6,8])
then inc(d);
canchk := (canchk shl 8) or map[cy,cx];
canfall := (d=2);
end;
function canwalk(vx,vy:integer): boolean;
var
cx,cy : integer;
d : byte;
begin
d := 0;
cx := (vx) shr 4; cy := (vy+16) shr 4;
canchk := map[cy,cx];
if map[cy,cx] in [1,3,5,6,8,10]
then d := 1;
cx := (vx+9) shr 4; cy := (vy+16) shr 4;
if map[cy,cx] in [1,3,5,6,8,10]
then inc(d);
canchk := (canchk shl 8) or map[cy,cx];
canwalk := (d=2);
end;
procedure zero(var valu:integer);
begin
if valu<0
then inc(valu)
else
if valu>0
then dec(valu);
end;
procedure calcitems;
var
p : plist;
begin
p := nkbeg;
while p<>nil do
begin
p^.item^.calcitemobject;
p := p^.next;
end;
end;
procedure addfire;
var
p : plist;
begin
new(p);
p^.item := new(pshot,init);
p^.item^.powner := p;
addp(nkbeg,nkend,p);
end;
procedure addsimmers;
var
p : plist;
begin
new(p);
p^.item := new(psimm,init);
p^.item^.powner := p;
addp(nkbeg,nkend,p);
end;
procedure finc(var i:byte;a:shortint);
begin
if i+a<0
then i := 0
else
if i+a>63
then i := 63
else inc(i,a);
end;
procedure brightcheck;
var
temp : RGBlist;
d : integer;
begin
if plus and (blv<20)
then
begin
inc(blv);
temp := dac;
for d := 0 to 255 do
with temp[d] do
begin
finc(red,blv);
finc(green,blv);
finc(blue,blv);
end;
fsetcolors(temp);
end;
if minus and (blv>-20)
then
begin
dec(blv);
temp := dac;
for d := 0 to 255 do
with temp[d] do
begin
finc(red,blv);
finc(green,blv);
finc(blue,blv);
end;
fsetcolors(temp);
end;
end;
procedure pause;
procedure dit;
begin
MyCycle^.docycle(3,2,2);
update; strobe;
brightcheck;
end;
begin
paused := true;
if ScardHere
then Scard_pause;
repeat dit; until ch<>'P';
repeat dit; until (ch='P') and not funct;
repeat dit; until ch<>'P';
if ScardHere
then Scard_resume;
paused := false;
setpageactive(2);
end;
procedure checkotherkeys(var detwait:boolean);
var
temp : RGBlist;
d : integer;
begin
if (ch='P') and not funct
then pause;
brightcheck;
if (ch='D') and not speedw
then
begin
speed := not speed;
speedw := true;
end
else
if (ch<>'D') and speedw
then speedw := false;
case ch of
'A' : addnake;
'S' : addsimmers;
end;
end;
function sgn(h:integer):integer;
begin
if h<0
then sgn := -1
else
if h>0
then sgn := 1
else sgn := 0;
end;
procedure setIPkeys;
const
jl : array[1..9,0..1] of shortint =
((-1,1),(0,1),(1,1),(-1,0),(0,0),
(1,0),(-1,-1),(0,-1),(1,-1));
var
d,jx,jy : integer;
begin
fillchar(ip,sizeof(ip),false);
firew := false;
if space
then firew := true;
for d := 1 to 9 do
if np[d,2]
then ip[d] := true;
if boolean(joydo)
then
begin
setstick(joydo);
jx := stickx[joydo] div jcx-1;
jy := sticky[joydo] div jcy-1;
for d := 1 to 9 do
if (jx=jl[d,0]) and (jy=jl[d,1])
then ip[d] := true;
if button1[joydo]
then firew := true;
end;
end;
procedure getkey;
var
up,ovx,ovy : integer;
detwait : boolean;
begin
with player do
begin
clearbuffer; up := 0; detwait := false;
repeat
setIPkeys;
checkotherkeys(detwait);
if blown
then
begin
inc(flip);
if flip=15
then
begin
blown := false;
lvls[0] := 16;
lvls[1] := 10;
lvls[2] := 22;
safe := 100;
flip := 7;
drx := 0;
dec(guys);
{if guys=0 (**)
then gameover; }
end;
zero(vdx);
end
else
begin
case drx of
0 : begin
if safe>0
then dec(safe);
if ip[7] or ip[4] or ip[1]
then
begin
drx := 1; safe := 0;
turn := true;
end
else
if ip[9] or ip[6] or ip[3]
then
begin
drx := -1; safe := 0;
turn := true;
end;
end;
1 : if turn
then
if flip<14
then inc(flip,2)
else turn := false
else
begin
if ip[7] or ip[4] or ip[1]
then flip := (flip+1)mod 16;
if ip[9] or ip[6] or ip[3]
then
begin
flip := 15; vdx := 0;
drx := -1; turn := true;
end;
end;
-1 : if turn
then
if flip>1
then dec(flip,2)
else turn := false
else
begin
if ip[9] or ip[6] or ip[3]
then flip := (flip+1)mod 16;
if ip[7] or ip[4] or ip[1]
then
begin
flip := 0; vdx :=0;
drx := 1; turn := true;
end;
end;
end;
ovy := vy; ovx := vx;
if (ip[7] or ip[8] or ip[9]) and elevat(vx,vy)
then
begin
dec(vy);
up := -1;
vx := (vx+8) shr 4 shl 4;
end
else
if (ip[1] or ip[2] or ip[3]) and elevat(vx,vy+1)
then
begin
inc(vy);
vx := (vx+8) shr 4 shl 4;
up := 1;
end;
if (vx>0) and (ip[7] or ip[4] or ip[1])
then dec(vdx,1)
else
if (vx<smx) and (ip[9] or ip[6] or ip[3])
then inc(vdx,1)
else zero(vdx);
if firew and boolean(drx) and (lvls[2]>0)
then
begin
sounds[shoot]^.play;
addfire;
dec(lvls[2],2);
end
else
if (lvls[2]<22) and (random<0.2)
then inc(lvls[2]);
end;
ifix(vdx,-10,10);
if canfall(vx,vy)
then
begin
if elevat(vx,vy) and (up=-1)
then
begin
dec(vy);
vy := vy shr 4 shl 4;
vdy := 0;
end
else
if (up=1) or ((up=0) and ((hi(canchk)<>10) or (lo(canchk)<>10)))
then
begin
inc(vdy,3);
if vdy>15
then vdy := 15;
end
else up := 0;
end
else
begin
vy := vy shr 4 shl 4;
vdy := 0; up := 0;
if not blown and (ip[7] or ip[8] or ip[9])
then vdy := -abs(vdx);
end;
inc(vx,vdx); inc(vy,vdy);
if vx<16
then vx := ovx
else if vx>(gmx-2) shl 4
then vx := ovx;
calcitems;
MyMorph^.drawmap(vx,vy,gpic);
update;
cleankill_list(kill,nkbeg,nkend);
until esc;
end;
end;
function checkallhit(hx,hy:integer;item:pobjs) : boolean;
var
p : plist;
did : boolean;
begin
p := nkbeg; did := false;
while (p<>nil) and not did do
begin
if p^.item^.id { shots don't affect eachother (id=0) }
then did := p^.item^.checkhit(hx,hy,item);
p := p^.next;
end;
checkallhit := did;
end;
(**) { tshot Methods }
constructor tshot.init;
begin
nx := player.vx+8; ny := player.vy; explo := false;
ndy := 0; ndx := -12*player.drx; id := false;
nrx := -player.drx; mapcolor := $fb; pointage := 0;
flp := 0; timeo := 15; overshow := false;
end;
procedure tshot.drawitemobject;
begin
with player do
if range(nx,ny,vx-150,vy-80,vx+140,vy+80)
then fbitdraw(153+(nx-vx),84+(ny-vy),rsmisc[17]^);
end;
procedure tshot.calcitemobject;
var
p : plist;
begin
if random<0.8
then
if (nrx<0) and (ndx>-15)
then dec(ndx)
else
if (nrx>0) and (ndx<15)
then inc(ndx);
inc(nx,ndx); inc(ny,ndy); dec(timeo);
if timeo=0
then add2kill_list(kill,powner)
else
if checkallhit(nx,ny,@self)
then add2kill_list(kill,powner);
end;
function tshot.checkhit(hx,hy:integer;var item:pobjs):boolean;
begin
checkhit := false;
end;
(**) { Tclod Methods }
constructor tclod.init;
begin
mapcolor := 0; id := false;
overshow := true;
nx := random(gmx shl 4);
ny := random((gmy-6) shl 4);
repeat
ndx := random(7)-3;
until boolean(ndx);
ndy := 0;
end;
procedure tclod.drawitemobject;
begin
with player do
if range(nx,ny,vx-150,vy-90,vx+130,vy+80)
then fbitdraw(153+(nx-vx),89+(ny-vy),rsmisc[0]^);
end;
procedure tclod.calcitemobject;
var
p : plist;
begin
inc(nx,ndx); inc(ny,ndy);
if nx<-300
then nx := gmx shl 4+300
else
if nx>gmx shl 4+300
then nx := -300;
end;
(**) { Tgirl Methods }
constructor tgirl.init;
begin
mapcolor := 163; id := true; goup := false;
overshow := false; flp := 0; godown := false;
with player do
repeat
nx := random(gmx shl 4);
ny := random((gmy-4) shl 4);
until canwalk(nx,ny) and not range(nx,ny,vx-150,vy-90,vx+130,vy+80);
if random<0.4
then ndx := -4
else ndx := 4;
ndy := 0; nrx := ndx;
end;
function tgirl.checkhit(hx,hy:integer;var item:pobjs):boolean;
begin
if range(hx,hy,nx,ny,nx+12,ny+24)
then
begin
sounds[girl_hit]^.play;
pshot(item)^.ndx := -pshot(item)^.ndx;
pshot(item)^.ndy := random(15)-7;
end;
checkhit := false;
end;
procedure tgirl.checkplayertouch;
var
dir : integer;
begin
with player do
if not boolean(safe) and not blown and range(nx+9,ny,vx-40,vy,vx+80,vy+10)
then
begin
if boolean(ndx)
then nrx := ndx;
dir := (nx-vx);
if dir<-10
then ndx := 4
else
if dir>10
then ndx := -4
else ndx := 0;
end
else
if ndx=0
then ndx := nrx;
end;
procedure tgirl.calcitemobject;
var
ox,oy,b : integer;
begin
ox := nx; oy := ny;
if canfall(nx,ny)
then
begin
if ndy<16
then inc(ndy);
end
else
begin
ndy := 0;
ny := ny shr 4 shl 4;
end;
inc(nx,ndx); inc(ny,ndy);
if (nx<16) or (nx>(gmx-2)shl 4)
then
begin
nx := ox;
ndx := -ndx;
end;
if not canwalk(nx,ny) and canwalk(ox,oy) and (random<0.4)
then
begin
nx := ox;
ndx := -ndx;
end;
if not goup and not godown
then flp := (flp+1)mod 16;
end;
procedure tgirl.drawitemobject;
begin
with player do
if range(nx,ny,vx-160,vy-60,vx+140,vy+60)
then
if ndx<0
then fbitdraw(153+(nx-vx),68+(ny-vy),girls[flp]^)
else
if ndx>0
then fbitdraw(153+(nx-vx),68+(ny-vy),girls[flp+16]^)
else
if (nx<vx)
then fbitdraw(153+(nx-vx),68+(ny-vy),girls[16]^)
else fbitdraw(153+(nx-vx),68+(ny-vy),girls[0]^);
end;
(**) { Tnake Methods }
constructor tnake.init;
begin
repeat
nx := random(gmx shl 4);
ny := random(gmy-3) shl 4;
until canwalk(nx,ny); pointage := 125;
mapcolor := 99; id := true; explo := false;
repeat
ndx := random(11)-5;
until boolean(ndx);
ndy := 0; overshow := false;
flp := 0; trn := false;
if ndx<0
then nrx := -1
else nrx := 1;
end;
function tnake.checkhit(hx,hy:integer;var item:pobjs):boolean;
begin
if not explo and range(hx,hy,nx,ny,nx+12,ny+24)
then
begin
sounds[explode]^.play;
explo := true; flp := 0;
if player.vx<nx
then nrx := -1
else nrx := 1;
checkhit := true;
inc(player.score,pointage);
printscore;
end
else checkhit := false;
end;
procedure tnake.drawitemobject;
begin
with player do
if range(nx,ny,vx-150,vy-60,vx+140,vy+60)
then
if explo
then
if ndx<0
then
if nrx<0
then fbitdraw(153+(nx-vx),72+(ny-vy),nakes[100+flp]^)
else fbitdraw(153+(nx-vx),72+(ny-vy),nakes[83+flp]^)
else
if nrx<0
then fbitdraw(153+(nx-vx),72+(ny-vy),nakes[66+flp]^)
else fbitdraw(153+(nx-vx),72+(ny-vy),nakes[49+flp]^)
else
if trn
then fbitdraw(153+(nx-vx),72+(ny-vy),nakes[flp+32]^)
else
if ndx<0
then fbitdraw(153+(nx-vx),72+(ny-vy),nakes[flp+16]^)
else fbitdraw(153+(nx-vx),72+(ny-vy),nakes[flp]^);
end;
procedure tnake.checkplayertouch;
begin
with player do
if not boolean(safe) and not blown and range(vx+9,vy+14,nx,ny,nx+24,ny+30)
then
begin
vdx := ndx; vdy := ndy;
if nrx=drx
then
begin
drx := -drx;
if drx<0
then flip := 15
else flip := 0;
turn := true;
end;
if lvls[0]>0
then dec(lvls[0],1);
if lvls[0]=0
then
begin
blown := true;
sounds[fried]^.play;
flip := 0;
end;
end;
end;
procedure tnake.calcitemobject;
var
ox,oy : integer;
begin
ox := nx; oy := ny;
if not explo
then
begin
inc(nx,ndx);
inc(ny,ndy);
end;
if nx<16
then nx := (gmx-2) shl 4
else
if nx>(gmx-2)shl 4
then nx := 16;
if not canwalk(nx,ny)
then
begin
nx := ox; ndx := -ndx;
trn := true;
nrx := -nrx;
if nrx<0
then flp := 15
else flp := 0;
end;
if not explo
then checkplayertouch;
if explo
then
begin
inc(flp);
if flp=15
then add2kill_list(kill,powner)
end
else
if trn
then
if nrx>0
then
begin
inc(flp);
if flp=15
then trn := false;
end
else
begin
dec(flp);
if flp=0
then trn := false;
end
else flp := (flp+1) mod 16;
end;
(**) { Tsimm methods }
constructor tsimm.init;
begin
repeat
nx := random(gmx shl 4);
ny := random(gmy-3) shl 4;
until canwalk(nx,ny); pointage := 275;
mapcolor := 0; id := true; explo := false;
ndx := 5;
nrx := 1;
if random<0.4
then
begin
ndx := -5;
nrx := -1;
end;
ndy := 0; overshow := false;
flp := 0; trn := false;
end;
procedure tsimm.drawitemobject;
begin
with player do
if range(nx,ny,vx-150,vy-60,vx+140,vy+60)
then
if explo
then
begin
end
else
if trn
then fbitdraw(153+(nx-vx),77+(ny-vy),simmers[flp]^)
else
if ndx<0
then fbitdraw(153+(nx-vx),77+(ny-vy),simmers[0]^)
else fbitdraw(153+(nx-vx),77+(ny-vy),simmers[15]^);
end;
procedure tsimm.checkplayertouch;
begin
with player do
if not boolean(safe) and not blown and range(vx+9,vy+14,nx,ny,nx+24,ny+30)
then
begin
vdx := ndx; vdy := ndy;
if nrx=drx
then
begin
drx := -drx;
if drx<0
then flip := 15
else flip := 0;
turn := true;
end;
if lvls[0]>0
then dec(lvls[0],1);
if lvls[0]=0
then
begin
blown := true;
sounds[fried]^.play;
flip := 0;
end;
end;
end;
(**) { TMyCycle methods }
procedure TMyCycle.cycle_move;
begin
cyclex := player.vx div 6;
cycley := (player.vy div 6) mod cyc_height;
end;
(**) { TMyMorph methods }
function TMyMorph.geomap(x,y:integer):integer;
begin
geomap := map[y,x];
end;
procedure TMyMorph.placegeo(x,y,geonum:integer;var geos);
begin
if geonum in [1..geo_count]
then
begin
if speed
then fbitdraw(x,y,gpic[geonum-1]^)
else fastwput(x,y,gpic[geonum-1]^);
end;
end;
procedure TMyMorph.pre_map;
begin
strobe;
setpageActive(2);
if speed
then
begin
MyCycle^.docycle(3,2,2);
drawitems(false);
drawperson;
end
else fastwmatte(13,20,172+128,179-32,pages[3]^,pages[2]^);
end;
procedure TMyMorph.post_map;
begin
if not speed
then
begin
drawitems(false);
drawperson;
end;
drawitems(true);
end;
begin
setup;
setparms;
printscore;
getkey;
end.